perm filename WINGS[G,BGB] blob
sn#064714 filedate 1974-01-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00012 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE WINGS - THE WINGED EDGE SUBROUTINES - JULY 1972.
C00011 00003 SUBR(MKF,BODY) MAKE FACE NODE ON A BODY.
C00013 00004 SUBR(KLF,BODY,FNEW) KILL FACE NODE.
C00015 00005 SUBR(WING,EDG1,EDG2) PLACE WING POINTERS BETWEEN TWO EDGES.
C00017 00006 SUBR(LINKED,ENT1,ENT2)DETERMINE WHETHER TWO FEV ENTITIES ARE LINKED.
C00020 00007 INTERN ERIGHT,ELEFT DIRECTED EDGE FETCH.
C00022 00008 SUBR(ECW,FEV,FV) FETCH EDGE CLOCKWISE FROM FEV ABOUT FV.
C00024 00009 SUBR(OTHER,EDG,FV) GET OTHER FACE OR VERTEX OF AN EDGE.
C00026 00010 SUBR(BGET,ENTITY) FETCH THE BODY OF AN ENTITY.
C00028 00011 SUBR(BDET,BODY) BODY DETACH.
C00030 00012 SUBR(VCW,EDGE,FACE)FETCH VERTEX CLOCKWISE FROM EDGE ABOUT FACE.
C00033 ENDMK
C⊗;
TITLE WINGS - THE WINGED EDGE SUBROUTINES - JULY 1972.
EXTERN MKNODE,KLNODE,UNIVERSE
SUBR(MKB,Q) ;MAKE BODY IN THE WORLD OF Q.
COMMENT ⊗------------------------------------------------------------
⊗
CALL(MKNODE,{[BBIT+PBIT+$BODY]}) ;CREATE NODE.
PUSHP 2↔PUSHP 3
DIP 1,1↔DAC 1,1(1)↔DAC 1,2(1)↔DAC 1,3(1) ;FEV - RINGS.
SKIPN 3,Q↔GO[LAC 3,UNIVER↔NWRLD 3,3↔GO .+1] ;NOW WORLD.
TESTZ 3,BBIT↔CCW 3,3↔CW 2,3 ;GET WORLD.
CW. 1,3↔CCW. 3,1↔CCW. 1,2↔CW. 2,1 ;WORLD RINGIN.
CDR 1,1↔POPP 3↔POPP 2↔POP1J ;RETURN BNEW.
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(MKFRAME) ;MAKE A FRAME OF REFERENCE NODE.
COMMENT ⊗------------------------------------------------------------
⊗
CALL(MKNODE,[1.0])
SLACI(<1.0>)
DAC IX(1)
DAC JY(1)
DAC KZ(1)
POP0J
ENDR MKFRAME;3/13/73(BGB)--------------------------------------------
SUBR(KLB,BNEW) ;KILL A BODY NODE.
COMMENT ⊗------------------------------------------------------------
⊗
B←1 ↔ X←2 ↔ Y←3
LAC B,ARG1
CW X,B↔CCW Y,B ;DELETE FROM ALBODY RING.
CW. X,Y↔CCW. Y,X
CALL(KLNODE,B)
POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(KLBFEV,Q) ;KILL ENTITY.
COMMENT ⊗------------------------------------------------------------
⊗
ACCUMULATORS{B,F,E,V}
LAC B,ARG1
SETQ(B,{BGET,B})
L1: PFACE F,B↔CAME F,B↔GO[CALL KLF,B,F↔GO L1]
L2: PED E,B↔CAME E,B↔GO[CALL KLE,B,E↔GO L2]
L3: PVT V,B↔CAME V,B↔GO[CALL KLV,B,V↔GO L3]
CALL KLB,B
POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(MKF,BODY) ;MAKE FACE NODE ON A BODY.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1 ↔ X←2 ↔ B←3
CALL(MKNODE,{[FBIT+$FACE]}) ;FACE NODE.
PUSH P,X↔PUSH P,B
LAC B,ARG3↔NFACE X,B↔PFACE. Q,X
NFACE. Q,B↔PFACE. B,Q↔NFACE. X,Q ;RINGIN.
POP P,B↔POP P,X↔POP1J
ENDR MKF;1/13/73(BGB)------------------------------------------------
SUBR(MKE,BODY) ;MAKE EDGE NODE ON A BODY.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1 ↔ X←2 ↔ B←3
CALL(MKNODE,{[EBIT+$EDGE]}) ;EDGE NODE.
PUSH P,X↔PUSH P,B
LAC B,ARG3↔NED X,B↔PED. Q,X
NED. Q,B↔PED. B,Q↔NED. X,Q ;RINGIN.
CCW. B,Q
POP P,B↔POP P,X↔POP1J
ENDR MKE;1/13/73(BGB)------------------------------------------------
SUBR(MKV,BODY) ;MAKE VERTEX NODE ON A BODY.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1 ↔ X←2 ↔ B←3
CALL(MKNODE,{[VBIT+$VERT]}) ;VERTEX NODE.
PUSH P,X↔PUSH P,B
LAC B,ARG3↔NVT X,B↔PVT. Q,X
NVT. Q,B↔PVT. B,Q↔NVT. X,Q ;RINGIN.
POP P,B↔POP P,X↔POP1J
ENDR MKV;1/13/73(BGB)------------------------------------------------
SUBR(KLF,BODY,FNEW) ;KILL FACE NODE.
COMMENT ⊗------------------------------------------------------------
⊗↔ X←2 ↔ Y←B←3
LAC 1,ARG1↔PUSH P,2↔PUSH P,3
NFACE X,1↔PFACE Y,1 ;DELETE FROM FACE RING.
NFACE. X,Y↔PFACE. Y,X
CALL(KLNODE,1)
POP P,3↔POP P,2↔POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(KLE,BODY,ENEW) ;KILL EDGE NODE.
COMMENT ⊗------------------------------------------------------------
⊗↔ X←2 ↔ Y←B←3
LAC 1,ARG1↔PUSH P,2↔PUSH P,3
NED X,1↔PED Y,1 ;DELETE FROM EDGE RING.
NED. X,Y↔PED. Y,X
CALL(KLNODE,1)
POP P,3↔POP P,2↔POP2J
POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(KLV,BODY,VNEW) ;KILL VERTEX NODE.
COMMENT ⊗------------------------------------------------------------
⊗↔ X←2 ↔ Y←B←3
LAC 1,ARG1↔PUSH P,2↔PUSH P,3
NVT X,1↔PVT Y,1 ;DELETE FROM VERTEX RING.
NVT. X,Y↔PVT. Y,X
CALL(KLNODE,1)
POP P,3↔POP P,2↔POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(WING,EDG1,EDG2) ;PLACE WING POINTERS BETWEEN TWO EDGES.
COMMENT ⊗------------------------------------------------------------
THE AC-0 CONTROL BITS:
[0-NV2-NV1] [0-PV2-PV1] [0-NF2-NF1] [0-PF2-PF1].
⊗↔ E1←3 ↔ E2←4
SAVAC(4)↔SETZ↔CDR E1,ARG2↔CDR E2,ARG1
;FIND THE COMMON VERTEX.
;AC-1 ← (NV1,,PV1) ⊗ (NV2,,PV2) NN,,PP IN COMMON.
;AC-2 ← (PV1,,NV1) ⊗ (NV2,,PV2) PN,,NP IN COMMON.
LAC 1,3(E1)↔MOVS 2,1↔XOR 1,3(E2)↔XOR 2,3(E2)
TLNN 1,-1↔TRO 3000↔TRNN 1,-1↔TRO 0300
TLNN 2,-1↔TRO 2100↔TRNN 2,-1↔TRO 1200
;FIND THE COMMON FACE.
LAC 1,1(E1)↔MOVS 2,1↔XOR 1,1(E2)↔XOR 2,1(E2)
TLNN 1,-1↔TRO 0030↔TRNN 1,-1↔TRO 0003
TLNN 2,-1↔TRO 0021↔TRNN 2,-1↔TRO 0012
;STORE THE WINGS AS INDICATED.
SETCA
TRNN 2020↔NCW. E1,E2↔TRNN 1010↔NCW. E2,E1
TRNN 2002↔PCCW. E1,E2↔TRNN 1001↔PCCW. E2,E1
TRNN 0220↔NCCW. E1,E2↔TRNN 0110↔NCCW. E2,E1
TRNN 0202↔PCW. E1,E2↔TRNN 0101↔PCW. E2,E1
GETAC(4)↔POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(LINKED,ENT1,ENT2);DETERMINE WHETHER TWO FEV ENTITIES ARE LINKED.
COMMENT ⊗------------------------------------------------------------
⊗
ACCUMULATORS{Q1,Q2,E}
EXCH Q1,ENT1↔EXCH Q2,ENT2↔PUSHP E
;BRANCH ON THE COMBINATION OF ARGUMENT TYPES.
LDB 0,[POINT 3,(Q1),16]↔LDB 1,[POINT 3,(Q2),16]
CAMLE 0,1↔EXCH Q1,Q2
IOR 1,0↔GO@[FALSE↔FF↔EE↔FE↔VV↔FV↔EV↔FALSE](1)
;FACES WITH COMMON EDGE.
FF: PED E,Q1↔DAC E,E0#
CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO FF+2↔GO FALSE
;EDGE IN FACE PERIMETER.
FE: PFACE 1,Q2↔CAMN 1,Q1↔GO TRUE
NFACE 1,Q2↔CAMN 1,Q1↔GO TRUE↔GO FALSE
;VERTEX IN FACE PERIMETER.
FV: PED E,Q2↔DAC E,E0
JUMPE E,[PFACE 1,Q1↔PVT 0,Q2↔CAME 0,1↔GO FALSE↔GO TRUE]
PFACE 1,E↔CAMN 1,Q1↔GO TRUE↔NFACE 1,E↔CAMN 1,Q1↔GO TRUE
SETQ(E,{ECCW,E,Q2})↔CAME E,E0↔GO FV+2↔GO FALSE
;EDGES WITH A COMMON VERTEX.
EE: PVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
NVT 1,Q2↔CAMN 0,1↔GO TRUE
NVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
NVT 1,Q2↔CAMN 0,1↔GO TRUE↔GO FALSE
;VERTEX IN EDGE.
EV: PVT 1,Q1↔CAMN 1,Q2↔GO TRUE
NVT 1,Q1↔CAMN 1,Q2↔GO TRUE↔GO FALSE
;VERTICES WITH A COMMON EDGE.
VV: PED E,Q1↔DAC E,E0
CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO VV+2↔GO FALSE
FALSE: TDCA 1,1
TRUE: SETO 1,↔POPP E
LAC Q1,ENT1↔LAC Q2,ENT2
POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
INTERN ERIGHT,ELEFT ;DIRECTED EDGE FETCH.
COMMENT ⊗------------------------------------------------------------
V EDGE FETCH MANDALA
/ \
/ \
/ \
ELEFT F ERIGHT
/ \
/ \
⊗
ERIGHT: TDZA 1,1 ;E ← ERIGHT(FROM-V,ABOUT-F).
ELEFT: SETO 1, ;E ← ELEFT(FROM-V,ABOUT-F).
BEGIN EFETCH
ACCUMULATORS{V,F,E1,E2}
Q←←1
SAVAC(5)
DAC Q,QFLAG#↔LAC V,ARG2↔LAC F,ARG1
TEST V,VBIT↔GO[SETCMM QFLAG↔EXCH F,V↔GO .+1]
PED E2,V↔DAC E2,E0#
L1: LAC E1,E2
;E2←ECW(E1,V) AND Q←FCW(E1,V).
PVT Q,E1↔CAME Q,V↔GO .+4
NCCW E2,E1↔NFACE Q,E1↔GO .+6
NVT Q,E1↔CAME Q,V↔GO[FATAL(EFETCH1)]
PCCW E2,E1↔PFACE Q,E1
CAMN Q,F↔GO L2
CAME E2,E0↔GO L1
FATAL(EFETCH2)
L2: LAC 1,E1↔SKIPE QFLAG↔LAC 1,E2
GETAC(5)↔POP2J
BEND;1/13/73(BGB)----------------------------------------------------
SUBR(ECW,FEV,FV) ;FETCH EDGE CLOCKWISE FROM FEV ABOUT FV.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1 ↔ X←2 ↔ E←3
CDR 1,ARG2↔TEST 1,EBIT↔GO ERIGHT
DAC 2,AC2↔ DAC 3,AC3
CDR X,ARG1↔LAC E,1
TEST X,VBIT↔GO[
PFACE Q,E↔CAME Q,X↔GO L1↔ PCW Q,E↔GO L
L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L]
PVT Q,E↔CAME Q,X↔GO L2↔ NCCW Q,E↔GO L
L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PCCW Q,E↔GO L
DIE: FATAL(ECW)
L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(ECCW,FEV,FV) ;FETCH EDGE CCW FROM FEV ABOUT FV.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1 ↔ X←2 ↔ E←3
CDR 1,ARG2↔TEST 1,EBIT↔GO ELEFT
DAC 2,AC2↔ DAC 3,AC3
CDR X,ARG1↔LAC E,1
TEST X,VBIT↔GO[
PFACE Q,E↔CAME Q,X↔GO L1↔ PCCW Q,E↔GO L
L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCCW Q,E↔GO L]
PVT Q,E↔CAME Q,X↔GO L2↔ PCW Q,E↔GO L
L2: NVT Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L
DIE: FATAL(ECCW)
L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
ENDR;1/13/73(BGB)-------------------------------------------------
SUBR(OTHER,EDG,FV) ;GET OTHER FACE OR VERTEX OF AN EDGE.
COMMENT ⊗------------------------------------------------------------
⊗
Q←←1↔X←←2↔E←←3
DAC 2,AC2↔DAC 3,AC3
CDR X,ARG1↔CDR E,ARG2
TEST X,FBIT↔GO L1
;OTHER FACE OF THE EDGE.
PFACE Q,E↔CAME Q,X↔GO .+3↔NFACE Q,E↔GO .+5
NFACE Q,E↔CAME Q,X↔GO[FATAL({OTHER FACE})]
PFACE Q,E↔LAC 2,AC2↔LAC 3,AC3↔POP2J
;OTHER VERTEX OF THE EDGE.
L1: PVT Q,E↔CAME Q,X↔GO .+3↔NVT Q,E↔GO .+5
NVT Q,E↔CAME Q,X↔GO[FATAL({OTHER VERTEX})]
PVT Q,E↔LAC 2,AC2↔LAC 3,AC3↔POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(OTHER.,FVNEW,EDG,FV) ;PUT OTHER FACE OR VERTEX OF AN EDGE.
COMMENT ⊗------------------------------------------------------------
⊗
Q←←1↔X←←2↔E←←3
DAC 2,AC2↔DAC 3,AC3
CDR X,ARG1↔CDR E,ARG2↔CDR Q,ARG3
TEST X,VBIT↔GO[
PFACE 0,E↔CAME 0,X↔GO L1↔NFACE. Q,E↔GO L
L1: NFACE 0,E↔CAME 0,X↔GO DIE↔PFACE. Q,E↔GO L]
NVT 0,E↔CAME 0,X↔GO L2↔PVT. Q,E↔GO L
L2: PVT 0,E↔CAME 0,X↔GO DIE↔NVT. Q,E↔GO L
DIE: FATAL(OTHER.)
L: LAC 2,AC2↔LAC 3,AC3
POP3J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(BGET,ENTITY) ;FETCH THE BODY OF AN ENTITY.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1
CDR Q,ENTITY
L1: LAC 0,(Q)↔TLNE 0,1B9↔POP1J ;FRAMES LOSE QUICKLY
ANDI 0,17
ADD 0,[@TABLE]
GO @0
TABLE: POP1J.↔POP1J.↔POP1J.↔POP1J. ;FRAME,EMTPY,UNIVERSE,LAMP
POP1J.↔POP1J.↔POP1J.↔POP1J. ;CAMERA,WORLD,WINDOW,IMAGE
[TCW Q,Q↔GO L1]↔POP1J. ;TEXT,XNODE
[NY Q,Q↔GO L1]↔POP1J. ;YNODE,ZNODE
POP1J.↔[PFACE 0,Q↔GO L2] ;BODY,FACE
[CCW Q,Q↔POP1J]↔[PVT 0,Q↔GO L2] ;EDGE,VERTEX
L2: PED Q,Q↔JUMPN Q,[CCW Q,Q↔POP1J]↔LAC 1,0↔POP1J
LIT
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(BDET,BODY) ;BODY DETACH.
COMMENT ⊗------------------------------------------------------------
⊗
LAC 1,BODY
TESTZ 1,FBIT+EBIT+VBIT↔POP1J
BRO 2,1↔SIS 3,1
BRO. 2,3↔SIS. 3,2 ;RINGO.
CAMN 2,1↔SETZ 2,
DAD 3,1↔SON 0,3
CAMN 0,1↔SON. 2,3 ;DAD OUT.
SETZ↔DAD. 0,1
BRO. 0,1↔SIS. 0,1 ;CLEAR SELF.
POP1J
ENDR;2/17/73(BGB)----------------------------------------------------
SUBR(BATT,B1,B2) ;BODY ATTACH B1 TO B2.
COMMENT ⊗------------------------------------------------------------
⊗
LAC 1,B1↔LAC 2,B2
CAMN 1,2↔POP2J ;PREVENT INCEST.
$TYPE 0,2↔CAIN 0,$WINDOW↔GO[ ;SPECIAL WINDOW CASES.
$TYPE 0,1↔CAIN 0,$CAMERA↔GO[ALT. 1,2↔POP2J]
CAIE 0,$IMAGE↔CAIN 0,$WORLD
GO[ALT2. 1,2↔POP2J]↔GO .+1]
TESTZ 1,FBIT+EBIT+VBIT↔POP2J
DAD 0,1
JUMPN[CALL(BDET,1)↔GO .+1] ;MAKE B1 AN ORPHAN.
LAC 2,ARG1
TESTZ 2,FBIT+EBIT+VBIT↔POP2J
DAD. 2,1 ;B2 IS B1'S NEW DADDY.
SON 3,2↔JUMPE 3,[SON. 1,2
BRO. 1,1↔SIS. 1,1↔POP2J] ;FIRST CHILD CASE.
BRO 2,3
BRO. 2,1↔SIS. 1,2 ;MANY CHILD CASE.
SIS. 3,1↔BRO. 1,3
POP2J
ENDR;2/17/73(BGB)----------------------------------------------------
SUBR(VCW,EDGE,FACE);FETCH VERTEX CLOCKWISE FROM EDGE ABOUT FACE.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1↔E←2
DAC 2,AC2↔CDR E,ARG2
PFACE Q,E↔CAME Q,ARG1↔GO .+3↔PVT Q,E↔GO L
NFACE Q,E↔CAME Q,ARG1↔GO[FATAL(VCW)]↔NVT Q,E
L: LAC 2,AC2↔POP2J
ENDR VCW;1/13/73(BGB)------------------------------------------------
SUBR(VCCW,EDGE,FACE);FETCH VERTEX CCW FROM EDGE ABOUT FACE.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1↔E←2
DAC 2,AC2↔CDR E,ARG2
PFACE Q,E↔CAME Q,ARG1↔GO .+3↔NVT Q,E↔GO L
NFACE Q,E↔CAME Q,ARG1↔GO[FATAL(VCCW)]↔PVT Q,E
L: LAC 2,AC2↔POP2J
ENDR VCCW;1/13/73(BGB)-----------------------------------------------
SUBR(FCW,EDGE,VERTEX);FETCH FACE CLOCKWISE FROM EDGE ABOUT VERTEX.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1↔E←2
DAC 2,AC2↔CDR E,ARG2
PVT Q,E↔CAME Q,ARG1↔GO .+3↔NFACE Q,E↔GO L
NVT Q,E↔CAME Q,ARG1↔GO[FATAL(FCW)]↔PFACE Q,E
L: LAC 2,AC2↔POP2J↔LIT
ENDR FCW;1/13/73(BGB)------------------------------------------------
SUBR(FCCW,EDGE,VERTEX);FETCH FACE CCW FROM EDGE ABOUT VERTEX.
COMMENT ⊗------------------------------------------------------------
⊗
Q←1↔E←2
DAC 2,AC2↔CDR E,ARG2
PVT Q,E↔CAME Q,ARG1↔GO .+3↔PFACE Q,E↔GO L
NVT Q,E↔CAME Q,ARG1↔GO[FATAL(FCCW)]↔NFACE Q,E
L: LAC 2,AC2↔POP2J↔LIT
ENDR FCCW;1/13/73(BGB)----------------------------------------------
END
WING.FAI - EOF.